
package PurlExt::books;
use strict;

sub import {

    # Register the commands when they are loaded into the system
    Purl::Commands::register(
        name   => "sign",
        subRef => \&PurlExt::books::sign,
    );
    Purl::Commands::register(
        name   => "unsign",
        subRef => \&PurlExt::books::unsign,
    );
}

sub sign {
    my %args = @_;
    ( $args{target}, $args{message} ) = split( / /, $args{text}, 2 );
    my ($id);
    if ( substr( $args{target}, 0, 1 ) ne "#" ) {
        $id = &findContents( $args{actor}, $args{target} );
        $id = &findContents( $main::objects[ $args{actor} ]{"location"},
            $args{target} )
            if ( $id == $main::none );
    }
    else {
        $id = substr( $args{target}, 1 );
        $id = &main::idBounds($id);
    }
    if ( $id == $main::none ) {
        Purl::comm::sendTextToPlayer(
            target => $args{actor},
            text   => "I don't see that here."
        );
        return;
    }
    if ( length( $args{message} ) > 256 ) {
        Purl::comm::sendTextToPlayer(
            target => $args{actor},
            text   =>
                "Signatures are limited to 256 characters apiece. Please sign again (briefly). Sorry for the inconvenience."
        );
        return;
    }
    if (!(  ( $main::objects[$id]{"flags"} & $main::flags{"book"}{"value"} )
            && ( $main::objects[$id]{"type"} == $main::thing )
        )
        )
    {
        Purl::comm::sendTextToPlayer(
            target => $args{actor},
            text   => "You can't sign that!"
        );
        return $main::none;
    }
    if ( $main::objects[$id]{"flags"} & $main::flags{"once"}{"value"} ) {

        #If the once flag is set, remove all
        #previous signatures by this person.
        my ($name) = quotemeta( $main::objects[ $args{actor} ]{"name"} );
        $main::objects[$id]{"description"}
            =~ s/\r\n$name: [^\r\n]*\r\n/\r\n/g;
        $main::objects[$id]{"description"} =~ s/\r\n$name: [^\r\n]*$//g;
    }
    $main::objects[$id]{"description"} .= "\r\n"
        . $main::objects[ $args{actor} ]{"name"} . ": "
        . $args{message};
    Purl::comm::sendTextToPlayer(
        target => $args{actor},
        text   => $main::objects[$id]{"name"} . " signed."
    );
    &tellRoom(
        $main::objects[ $args{actor} ]{"location"},
        $args{actor},
        $main::objects[ $args{actor} ]{"name"}
            . " adds a signature to "
            . $main::objects[$id]{"name"} . "."
    );
}

sub unsign {
    my %args = @_;
    my ($id);
    $args{target} = $args{text};    
    if ( substr( $args{target}, 0, 1 ) ne "#" ) {
        $id = &findContents( $args{actor}, $args{target} );
        $id = &findContents( $main::objects[ $args{actor} ]{"location"},
            $args{target} )
            if ( $id == $main::none );
    }
    else {
        $id = substr( $args{target}, 1 );
        $id = &main::idBounds($id);
    }
    if ( $id == $main::none ) {
        Purl::comm::sendTextToPlayer(
            target => $args{actor},
            text   => "I don't see that here."
        );
        return;
    }
    else {
        if (!(  (   $main::objects[$id]{"flags"}
                    & $main::flags{"book"}{"value"}
                )
                && ( $main::objects[$id]{"type"} == $main::thing )
            )
            )
        {
            Purl::comm::sendTextToPlayer(
                target => $args{actor},
                text   => "That's not a book!"
            );
            return;
        }
        my ($name) = quotemeta( $main::objects[ $args{actor} ]{"name"} );

        # No more global unsign -- take off the g
        $main::objects[$id]{"description"} =~ s/\r\n$name: [^\r\n]*\r\n/\r\n/;
        $main::objects[$id]{"description"} =~ s/\r\n$name: [^\r\n]*$//;
        Purl::comm::sendTextToPlayer(
            target => $args{actor},
            text   => $main::objects[$id]{"name"} . " unsigned."
        );
    }
}

1;
